home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok49 / oprof / txt / hilbert.mod < prev    next >
Text File  |  1993-11-04  |  4KB  |  183 lines
  1. (*
  2.   :Program.       Hilbert
  3.   :Author.        Volker Rudolph
  4.   :Address.       Lettow-Vorbeck-Str. 11 / 6750 Kaiserslautern 26
  5.   :Phone.         06301/8566
  6.   :Version.       1.0
  7.   :Date.          23.7.90
  8.   :Copyright.     PD
  9.   :Language.      Oberon (Freeware)
  10.   :Translator.    Amiga-Oberon V1.14
  11.   :Contents.      Zeichnet Hilbert-Kurven
  12. *)
  13.  
  14. MODULE Hilbert;
  15.  
  16. IMPORT e:Exec,i:Intuition,g:Graphics,Break,n:NoGuru,s:SYSTEM;
  17.  
  18. CONST
  19.   ScreenWidth = 350;
  20.   ScreenHeight = 282;
  21.   SquareSize = 256;
  22.  
  23. VAR
  24.   sc:i.ScreenPtr;
  25.   wi:i.WindowPtr;
  26.   msg:e.MsgPortPtr;
  27.  
  28. (* -------------------------------------------------------------------------- *)
  29.  
  30. PROCEDURE WaitForClick;
  31. BEGIN
  32.   e.WaitPort(wi.userPort);
  33.   msg := e.GetMsg(wi.userPort);
  34.   e.WaitPort(wi.userPort);
  35.   msg := e.GetMsg(wi.userPort);
  36. END WaitForClick;
  37.  
  38. PROCEDURE CreateGraphics;
  39. VAR
  40.   ns:i.NewScreen;
  41.   nw:i.NewWindow;
  42. BEGIN
  43.   ns.leftEdge := 0;
  44.   ns.topEdge := 0;
  45.   ns.width := ScreenWidth;
  46.   ns.height := ScreenHeight;
  47.   ns.depth := 3;
  48.   ns.detailPen := 1;
  49.   ns.blockPen := 2;
  50.   ns.viewModes := {};
  51.   ns.type := i.customScreen;
  52.   ns.font := NIL;
  53.   ns.defaultTitle := NIL;
  54.   ns.gadgets := NIL;
  55.   ns.customBitMap := NIL;
  56.   sc := i.OpenScreen(ns);
  57.   n.Assert(sc # NIL,"Can't open screen");
  58.  
  59.   nw.leftEdge := 0;
  60.   nw.topEdge := 0;
  61.   nw.width := ScreenWidth;
  62.   nw.height := ScreenHeight;
  63.   nw.detailPen := 1;
  64.   nw.blockPen := 2;
  65.   nw.idcmpFlags := LONGSET{i.mouseButtons};
  66.   nw.flags := LONGSET{i.borderless};
  67.   nw.firstGadget := NIL;
  68.   nw.checkMark := NIL;
  69.   nw.title := NIL;
  70.   nw.screen := sc;
  71.   nw.bitMap := NIL;
  72.   nw.minWidth := 0;
  73.   nw.minHeight := 0;
  74.   nw.maxWidth := ScreenHeight;
  75.   nw.maxHeight := ScreenHeight;
  76.   nw.type := i.customScreen;
  77.   wi := i.OpenWindow(nw);
  78.   n.Assert(wi # NIL,"Can't open window");
  79.   g.SetRGB4(s.ADR(sc.viewPort),2,15,15,0);
  80. END CreateGraphics;
  81.  
  82. PROCEDURE RemoveGraphics;
  83. BEGIN
  84.   IF wi # NIL THEN
  85.     i.CloseWindow(wi);
  86.     wi := NIL;
  87.   END; (* IF *)
  88.   IF sc # NIL THEN
  89.     i.CloseScreen(sc);
  90.     sc := NIL;
  91.   END; (* IF *)
  92. END RemoveGraphics;
  93.  
  94. PROCEDURE Line(direction,delta:INTEGER);
  95. BEGIN
  96.   CASE direction OF
  97.     0:g.Draw(wi.rPort,wi.rPort.x+delta,wi.rPort.y);
  98.    |2:g.Draw(wi.rPort,wi.rPort.x,wi.rPort.y-delta);
  99.    |4:g.Draw(wi.rPort,wi.rPort.x-delta,wi.rPort.y);
  100.    |6:g.Draw(wi.rPort,wi.rPort.x,wi.rPort.y+delta);
  101.   ELSE
  102.     n.Assert(FALSE,"Wrong direction");
  103.   END; (* CASE *)
  104. END Line;
  105.  
  106. (* -------------------------------------------------------------------------- *)
  107.  
  108. PROCEDURE Hilbert;
  109. VAR
  110.   i,x0,y0,u:INTEGER;
  111.  
  112.   PROCEDURE ^A(i:INTEGER);
  113.   PROCEDURE ^B(i:INTEGER);
  114.   PROCEDURE ^C(i:INTEGER);
  115.   PROCEDURE ^D(i:INTEGER);
  116.  
  117.   PROCEDURE A(i:INTEGER);
  118.   BEGIN
  119.     IF i > 0 THEN
  120.       D(i-1); Line(4,u);
  121.       A(i-1); Line(6,u);
  122.       A(i-1); Line(0,u);
  123.       B(i-1);
  124.     END; (* IF *)
  125.   END A;
  126.  
  127.   PROCEDURE B(i:INTEGER);
  128.   BEGIN
  129.     IF i > 0 THEN
  130.       C(i-1); Line(2,u);
  131.       B(i-1); Line(0,u);
  132.       B(i-1); Line(6,u);
  133.       A(i-1);
  134.     END; (* IF *)
  135.   END B;
  136.  
  137.   PROCEDURE C(i:INTEGER);
  138.   BEGIN
  139.     IF i > 0 THEN
  140.       B(i-1); Line(0,u);
  141.       C(i-1); Line(2,u);
  142.       C(i-1); Line(4,u);
  143.       D(i-1);
  144.     END; (* IF *)
  145.   END C;
  146.  
  147.   PROCEDURE D(i:INTEGER);
  148.   BEGIN
  149.     IF i > 0 THEN
  150.       A(i-1); Line(6,u);
  151.       D(i-1); Line(4,u);
  152.       D(i-1); Line(2,u);
  153.       C(i-1);
  154.     END; (* IF *)
  155.   END D;
  156.  
  157. BEGIN
  158.   x0 := ScreenWidth DIV 2;
  159.   y0 := ScreenHeight DIV 2;
  160.   u := SquareSize;
  161.   i := 0;
  162.   REPEAT
  163.     INC(i);
  164.     u := u DIV 2;
  165.     x0 := x0 + (u DIV 2);
  166.     y0 := y0 + (u DIV 2);
  167.     g.SetAPen(wi.rPort,i);
  168.     g.Move(wi.rPort,x0,ScreenHeight-y0);
  169.     A(i);
  170.     (* WaitForClick; *)
  171.   UNTIL (i = 6);
  172. END Hilbert;
  173.  
  174. (* -------------------------------------------------------------------------- *)
  175.  
  176. BEGIN
  177.   CreateGraphics;
  178.   Hilbert;
  179.   WaitForClick;
  180. CLOSE
  181.   RemoveGraphics;
  182. END Hilbert.
  183.